home *** CD-ROM | disk | FTP | other *** search
/ Archive Magazine CD 1995 / Archive Magazine CD 1995.iso / discs / prog_disc / volume_7 / issue_07 / basicforum / rmaheap (.txt) < prev   
Encoding:
RISC OS BBC BASIC V Source  |  1994-02-20  |  3.3 KB  |  143 lines
  1.  >HeapTest
  2.  Globals for test program
  3. quit%   = 
  4. a%      = 0
  5. b%      = 0
  6. blk%    = 0
  7. amount$ = ""
  8. g       = 0
  9.  A simple menu to test the heap procedures
  10.  "Select from..."                     
  11.  "1= fetch"'"2= return"'"3= resize"'"4= quit"
  12.   g = 
  13.  - 48
  14.        
  15.  "size to fetch: &"a$
  16.       
  17.  a$ <> "" 
  18.         a%   = 
  19. ("&" + a$)
  20. !        blk% = 
  21. _heap_get(a%)
  22.         
  23.  blk% > 0 
  24. 0          
  25.  '"Block allocated at &" + 
  26. ~blk%
  27.         
  28. 0          
  29.  '"Unable to claim enough memory"
  30.         
  31.       
  32. "      
  33.  "block to return: &"a$
  34.       
  35.  a$ <> "" 
  36.         a% = 
  37. ("&" + a$)
  38.         b% = a%
  39.         
  40. _heap_release(a%)
  41.         
  42.  (a% = 0) 
  43. #;          
  44.  '"Block at &" + 
  45. ~b% + " has been released"
  46.         
  47. %,          
  48.  '"No block exists at &"+
  49.         
  50.       
  51. )"      
  52.  "Block to resize: &"a$
  53. *0      
  54.  "Amount (-ve to decrease): &"amount$
  55.       
  56.  a$ <> "" 
  57.         a% = 
  58. ("&" + a$)
  59.         b% = a%
  60. .(        
  61. _heap_resize(a%,
  62. (amount$))
  63.         
  64.  (a% > 0) 
  65. 0<          
  66.  '"Block at &" + 
  67. ~b% + " has been resized ";
  68. 15          
  69.  a% <> b% 
  70.  "(now at &"+
  71. ~a%+")" 
  72.         
  73. 38          
  74.  a% = -3 
  75.  '"No block exists at &"+
  76. 4<          
  77.  a% = -2 
  78.  '"Unable to claim enough memory"
  79. 5>          
  80.  a% = -1 
  81.  '"Block size is now 0 or negative"
  82.         
  83.       
  84.       quit% = 
  85.  quit%
  86.  -- RMA Heap Procedures --------------------------------------------
  87.  Global variables used:
  88.    None
  89. _heap_get(size%)
  90.  ptr%,heap%,flags%
  91.  Returns pointer to new memory block unless claim fails
  92.  in which case -1 is returned
  93.  First find start address of RMA..
  94.  "OS_ReadDynamicArea",1 
  95.  heap%
  96.  Now claim memory, trapping errors by using X form of SWI..
  97.  "XOS_Module",6,,,size% 
  98.  ,,ptr%;flags%
  99.  If error occured return -1, else return address of allocated
  100.  block
  101.  (flags% 
  102.  ptr% = -1
  103. = ptr%
  104. _heap_release(
  105.  ptr%)
  106.  maxfree%,nrpages%,flags%
  107.  Returns  0 if block released OK
  108.  Returns -1 if operation failed (i.e. block doesn't exist)
  109.  "XOS_Module",7,,ptr% 
  110.  ;flags%:
  111.  Free the block
  112.  (flags% 
  113.  1) = 0 
  114.  Block was released successfully...
  115.   ptr% = 0
  116.  Error occured trying to free the block, return -1 to signal to the
  117.  program that something went wrong (normally the program would ignore
  118.  this anyway)
  119.   ptr% = -1
  120. _heap_resize(
  121.  ptr%,change%)
  122.  flags%,heap%
  123.  Returns a new pointer to the block (it may be moved in memory). Any data
  124.  in the block will be copied to the new location if necessary.
  125.  Returns -1 if the block now has a size of 0 or less
  126.  Returns -2 if claim fails due to lack of memory
  127.  Returns -3 if block does not exist
  128.  First find start address of RMA..
  129.  "OS_ReadDynamicArea",1 
  130.  heap%
  131.  Read size of block to check it exists (not strictly neccessary, but it
  132.  does enable us to give more meaningful error indications)
  133.  "XOS_Heap",6,heap%,ptr% 
  134.  ;flags%
  135.  (flags% 
  136.  It doesn't exist..
  137.   ptr% = -3
  138.  It does, so attempt to perform resize..
  139.  "XOS_Heap",4,heap%,ptr%,change% 
  140.  ,,ptr%;flags%
  141.  (flags% 
  142.  ptr% = -2
  143.